home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / swag / exec.swg / 0025_Menu System.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-24  |  11KB  |  296 lines
  1. {
  2.  GG> Could somebody post a message with the Pascal 6.0 source for some
  3.  GG> sort of a scrolling menu system?  I do NOT want TurboVision.  I
  4.  GG> HATE OOP.  I don't mind records and arrays, but i don't want OOP.
  5.  GG> I've done some programming for one myself....
  6. }
  7.  
  8. UNIT MPMENU;
  9. {
  10.  Written and designed by Michael Perry, (c) 1990 Progressive Computer Serv.
  11.  
  12.  A basic, flexible, user-definable menu system using only the most basic
  13.  functions in Turbo Pascal.  This unit is easily integratable into your
  14.  applications and gives you more versatility than most "pull down"-type
  15.  menu interfaces.
  16.  
  17.  License:  This unit should NOT be modified and redistributed in source
  18.            or object/TPU form.  You can modify and use this in any non-
  19.            commercial program free-of-charge provided that "Mike Perry"
  20.            if credited either in the program or documentation.  Use of
  21.            these routines in a commercially-sold package requires a
  22.            one-time registration fee of $30 to be sent to:
  23.  
  24.              Progressive Computer Services
  25.              P.O. Box 7638
  26.              Metairie, LA 70010
  27.  
  28.            Non-commercial users are also invited to register the code.
  29.            This insures that updates and future revisions are made
  30.            available and users are kept informed via mail.
  31.  
  32.  
  33.  Usage:    Implementing menus using the MPMENU unit involves just a
  34.            few basic steps.  At any point in your program, add code
  35.            to perform the following actions:
  36.  
  37.               1.  Define the menu by assigning values to the MENU_DATA
  38.                   record.
  39.               2.  Call the procedure MENU(MENU_DATA,RETURNCODE);
  40.               3.  Implement a routine to evaluate the value of
  41.                   RETURNCODE and act accordingly.  The values of
  42.                   RETURNCODE are as follows:
  43.                     0   = ESC pressed (menu aborted)
  44.                     1-x = The appropriate option was selected, with 1
  45.                           being the first menu choice, 2 the second,
  46.                           etc.
  47.  
  48.  Example:  Here is a sample main menu using the MENU procedure:
  49. -----------------------------------------------------------------------------
  50.    Program DontDoMuch;
  51.    Uses Crt,MPMenu;
  52.  
  53.    CONST     HELL_FREEZES_OVER=FALSE;
  54.    VAR       CHOICE:BYTE;
  55.  
  56.    Begin
  57.      REPEAT
  58.  
  59.      With Menu_Data Do Begin
  60.        Menu_Choices[1]:='1 - First Option ';    - define menu choice onscreen
  61.        Row[1]:=10; Column[1]:=30;               - where on screen displayed
  62.        Menu_Choices[2]:='2 - Second Option';    - same thing for 2nd choice
  63.        Row[2]:=12; Column[2]:=30;                 .
  64.        Menu_Choices[3]:='X - Exit Program ';      .
  65.        Row[3]:=14; Column[3]:=30;                 .
  66.        Onekey:=TRUE;                            - enable 1-key execution
  67.        Num_Choices:=3;                          - number of menu choices
  68.        HiLighted:=112;                          - highlighted attribute
  69.        Normal:=7;                               - normal attribute
  70.      End;
  71.  
  72.      MENU(MENU_DATA,CHOICE);          - call the menu now and wait for user
  73.  
  74.      Case Choice Of                   - evaluate user response and act
  75.        0:Halt;                        - ESC pressed
  76.        3:Halt;                        - option 3, Exit, selected
  77.        1:Begin
  78.            - put code here to do menu option 1
  79.          End;
  80.        2:Begin
  81.            - put code here to do menu option 2
  82.          End;
  83.      End
  84.  
  85.      UNTIL HELL_FREEZES_OVER;          - infinite loop - back to main menu
  86. End.
  87. -----------------------------------------------------------------------------
  88. }
  89. INTERFACE
  90.  
  91.   USES Crt;
  92.  
  93.   CONST
  94.     MAX_CHOICES = 10;                            { MAX_CHOICES can be changed
  95.                                                    depending upon the highest
  96.                                                    number of options you will
  97.                                                    have on any given menu }
  98.  
  99.   TYPE
  100.     MENU_ARRAY = RECORD                          { record structure for menu }
  101.       MENU_CHOICES : ARRAY[1..MAX_CHOICES] OF STRING[50];  { displayed option }
  102.       COLUMN       : ARRAY[1..MAX_CHOICES] OF BYTE;        { column location }
  103.       ROW          : ARRAY[1..MAX_CHOICES] OF BYTE;  { row location }
  104.       NUM_CHOICES  : BYTE;                           { # choices on menu }
  105.       HILIGHTED    : WORD;                           { attribute for hilight }
  106.       NORMAL       : WORD;                           { attributed for normal }
  107.       ONEKEY       : BOOLEAN;                        { TRUE for 1-key execution
  108. }
  109.     END;
  110.  
  111.   VAR
  112.     MENU_DATA : MENU_ARRAY;                      { global menu variable }
  113.  
  114. {
  115.   NOTE:  You can define many menu variables simultaneously, but since you
  116.          can generally use only one menu at a time, you can conserve
  117.          memory and program space by re-defining this one MENU_DATA record
  118.          each time a menu is to be displayed.
  119. }
  120.  
  121. { internal procedures }
  122.   PROCEDURE SHOW_MENU(MENU_DATA:MENU_ARRAY);
  123.   PROCEDURE HILIGHT_CHOICE(MENU_DATA:MENU_ARRAY;CHOICENUM:BYTE);
  124.   PROCEDURE UNHILIGHT_CHOICE(MENU_DATA:MENU_ARRAY;CHOICENUM:BYTE);
  125.   FUNCTION GETKEY(VAR FUNCTIONKEY:BOOLEAN):CHAR;
  126.   FUNCTION FOUND_CHOICE(MENU_DATA:MENU_ARRAY;VAR EXITCODE:BYTE;CH:CHAR):BOOLEAN;
  127.  
  128. { basically, the ONE callable procedure }
  129.   PROCEDURE MENU(MENU_DATA:MENU_ARRAY;VAR EXITCODE:BYTE);
  130.  
  131. IMPLEMENTATION
  132.  
  133.  
  134. (*===========================================================================*)
  135. PROCEDURE SHOW_MENU(MENU_DATA:MENU_ARRAY);
  136. { display defined menu array }
  137. VAR I:BYTE;
  138. BEGIN
  139.   TEXTATTR:=MENU_DATA.NORMAL;
  140.   FOR I:=0 TO (MENU_DATA.NUM_CHOICES-1) DO BEGIN
  141.     GOTOXY(MENU_DATA.COLUMN[I+1],MENU_DATA.ROW[I+1]);
  142.     WRITE(MENU_DATA.MENU_CHOICES[I+1]);
  143.   END;
  144. END;
  145. (*===========================================================================*)
  146. PROCEDURE HILIGHT_CHOICE(MENU_DATA:MENU_ARRAY;CHOICENUM:BYTE);
  147. { highlight the appropriate menu choice }
  148. BEGIN
  149.   GOTOXY(MENU_DATA.COLUMN[CHOICENUM],MENU_DATA.ROW[CHOICENUM]);
  150.   TEXTATTR:=MENU_DATA.HILIGHTED;
  151.   WRITE(MENU_DATA.MENU_CHOICES[CHOICENUM]);
  152.   { below needed if direct screen writing not done }
  153.   GOTOXY(MENU_DATA.COLUMN[CHOICENUM],MENU_DATA.ROW[CHOICENUM]);
  154. END;
  155. (*===========================================================================*)
  156. PROCEDURE UNHILIGHT_CHOICE(MENU_DATA:MENU_ARRAY;CHOICENUM:BYTE);
  157. { highlight the appropriate menu choice }
  158. BEGIN
  159.   GOTOXY(MENU_DATA.COLUMN[CHOICENUM],MENU_DATA.ROW[CHOICENUM]);
  160.   TEXTATTR:=MENU_DATA.NORMAL;
  161.   WRITE(MENU_DATA.MENU_CHOICES[CHOICENUM]);
  162. END;
  163. (*===========================================================================*)
  164. FUNCTION GETKEY(VAR FUNCTIONKEY:BOOLEAN):CHAR;
  165. { read keyboard and return character/function key }
  166. VAR CH: CHAR;
  167. BEGIN
  168.   CH:=ReadKey;
  169.   IF (CH=#0) THEN
  170.     BEGIN
  171.       CH:=ReadKey;
  172.       FUNCTIONKEY:=TRUE;
  173.     END
  174.   ELSE FUNCTIONKEY:=FALSE;
  175.   GETKEY:=CH;
  176. END;
  177. (*===========================================================================*)
  178. FUNCTION FOUND_CHOICE(MENU_DATA:MENU_ARRAY;VAR EXITCODE:BYTE;CH:CHAR):BOOLEAN;
  179. { locate next occurance of menu choice starting with char CH }
  180. VAR I:BYTE; TEMP:STRING;
  181. BEGIN
  182.   CH:=UPCASE(CH);
  183.   IF EXITCODE=MENU_DATA.NUM_CHOICES THEN BEGIN
  184.     TEMP:=MENU_DATA.MENU_CHOICES[1];
  185.     IF UPCASE(TEMP[1])=CH THEN BEGIN
  186.       UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);
  187.       EXITCODE:=1;
  188.       HILIGHT_CHOICE(MENU_DATA,EXITCODE);
  189.       FOUND_CHOICE:=TRUE;
  190.       EXIT;
  191.     END;
  192.   END;
  193.  
  194.   FOR I:=EXITCODE+1 TO MENU_DATA.NUM_CHOICES DO BEGIN
  195.     TEMP:=MENU_DATA.MENU_CHOICES[I];
  196.     IF UPCASE(TEMP[1])=CH THEN BEGIN
  197.       UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);
  198.       EXITCODE:=I;
  199.       HILIGHT_CHOICE(MENU_DATA,EXITCODE);
  200.       FOUND_CHOICE:=TRUE;
  201.       EXIT;
  202.     END;
  203.   END;
  204.  
  205.   IF EXITCODE<>1 THEN BEGIN             { KILLER RECURSION }
  206.     UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);
  207.     EXITCODE:=1;
  208.     IF FOUND_CHOICE(MENU_DATA,EXITCODE,CH) THEN BEGIN
  209.       HILIGHT_CHOICE(MENU_DATA,EXITCODE);
  210.       FOUND_CHOICE:=TRUE;
  211.       EXIT;
  212.     END ELSE HILIGHT_CHOICE(MENU_DATA,EXITCODE);
  213.   END ELSE BEGIN
  214.     TEMP:=MENU_DATA.MENU_CHOICES[1];
  215.     IF UPCASE(TEMP[1])=CH THEN BEGIN
  216.       FOUND_CHOICE:=TRUE;
  217.       EXIT;
  218.     END;
  219.   END;
  220.   FOUND_CHOICE:=FALSE;
  221. END;
  222. (*===========================================================================*)
  223. PROCEDURE MENU(MENU_DATA:MENU_ARRAY;VAR EXITCODE:BYTE);
  224. { display menu and return user's response:
  225.    0   = ESC pressed
  226.    1-x = appropriate choice selected
  227.  
  228.    during operation, variable EXITCODE holds number of currently-selected
  229.    menu choice.
  230. }
  231. VAR
  232.   FNC:BOOLEAN; TEMPATTR:WORD;
  233.   CH:CHAR;
  234. BEGIN
  235.   TEMPATTR:=TEXTATTR;
  236.   IF (EXITCODE=0) OR (EXITCODE>MENU_DATA.NUM_CHOICES) THEN
  237.     EXITCODE:=1;
  238.   SHOW_MENU(MENU_DATA);
  239.   HILIGHT_CHOICE(MENU_DATA,EXITCODE);
  240.   REPEAT
  241.     CH:=GETKEY(FNC);
  242.     IF FNC THEN BEGIN
  243.       IF CH=#77 THEN CH:=#80 ELSE
  244.       IF CH=#75 THEN CH:=#72;
  245.  
  246.       CASE CH OF
  247.         #72:IF EXITCODE>1 THEN BEGIN                              { UP }
  248.               UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);
  249.               EXITCODE:=EXITCODE-1;
  250.             END;
  251.         #80:IF EXITCODE<MENU_DATA.NUM_CHOICES THEN BEGIN          { DOWN }
  252.               UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);
  253.               EXITCODE:=EXITCODE+1;
  254.             END;
  255.         #71:IF EXITCODE<>1 THEN BEGIN                             { HOME }
  256.               UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);
  257.               EXITCODE:=1;
  258.             END;
  259.         #79:IF EXITCODE<MENU_DATA.NUM_CHOICES THEN BEGIN          { END }
  260.               UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);
  261.               EXITCODE:=MENU_DATA.NUM_CHOICES;
  262.             END;
  263.       END; { functionkey CASE }
  264.       HILIGHT_CHOICE(MENU_DATA,EXITCODE);
  265.     END { if FNC }
  266.  
  267.     ELSE
  268.       CASE CH OF
  269.         #27:BEGIN
  270.               EXITCODE:=0;
  271.               TEXTATTR:=TEMPATTR;
  272.               EXIT;
  273.             END;
  274.         #13:BEGIN
  275.               TEXTATTR:=TEMPATTR;
  276.               EXIT;
  277.             END;
  278.       ELSE
  279.         IF FOUND_CHOICE(MENU_DATA,EXITCODE,CH) THEN
  280.           IF (MENU_DATA.ONEKEY) THEN BEGIN
  281.             TEXTATTR:=TEMPATTR;
  282.             EXIT;
  283.           END ELSE { nothing }
  284.         ELSE
  285. {          BEGIN
  286.             GOTOXY(1,20);  used for debugging
  287.             WRITELN('FNC=',FNC,'      KEYVAL=',ORD(CH));
  288.           END;
  289.  }
  290.       END; {case}
  291.   UNTIL FALSE;
  292. END;
  293. (*===========================================================================*)
  294. END. { of unit MPMENU }
  295.  
  296.